home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr10 / tvprompt.zip / CRT.PKG < prev    next >
Text File  |  1992-04-09  |  5KB  |  128 lines
  1. With Altslice,
  2.      Bit,
  3.      Doscall,
  4.      System;
  5.  
  6. package body CRT is
  7. pragma all_checks(off);
  8. -- Copyright 1992 Tom Moran
  9.  
  10.   -- Note: we act as if the CRT had 100 lines at B800:0 .. B800:1FFF
  11.   -- The second 100 lines, interlaced with the first, come from
  12.   -- simply duplicating 0 .. 1FFF at 2000 .. 3FFF
  13.  
  14.   -- N*80 mod 8192 = 0  =>  N=512
  15.   Number_Of_Different_Offsets:constant:=512;
  16.  
  17.   subtype Line_Numbers is Integer range 0 .. Number_Of_Different_Offsets-1;
  18.   Line_At_Top : Line_Numbers := Line_Numbers'first;
  19.  
  20.   Video_Ram_Segment: constant System.Word := 16#B800#;
  21.   Video_Ram_Length:  constant := 16#4000#;
  22.   type Video_Ram_Addresses is range 0 .. Video_Ram_Length-1;
  23.   Odd_Bank_Offset : constant Video_Ram_Addresses := 16#2000#;
  24.   subtype Line_Addresses is Video_Ram_Addresses range 0 .. Odd_Bank_Offset-1;
  25.   Line_Address: array (Line_Numbers) of Line_Addresses;
  26.  
  27.   procedure Scroll(New_Scan_Line:   Full_Scan_Lines) is
  28.     Target:Line_Numbers;
  29.   begin
  30.     if Line_At_Top = Line_Numbers'last then
  31.       Line_At_Top:=Line_Numbers'first;
  32.     else
  33.       Line_At_Top:=Line_At_Top+1;
  34.     end if;
  35.     -- copy new line to bottom of screen
  36.     Target:=(Line_At_Top+Logical_Screen_Height-1) mod Line_Address'length;
  37.  
  38.     -- a line may wrap in the middle from Line_Addresses'last to
  39.     -- to Line_Addresses'first.
  40.     -- If so, the odd bank copy of the tail will go at Odd_Bank_Offset,
  41.     -- which is exactly Line_Addresses'last+1, so it needn't wrap at all!
  42.     -- Unfortunately, the tail of the odd bank copy is supposed to wrap
  43.     -- from Video_Ram_Addresses'last to Video_Ram_Addresses'first, which
  44.     -- won't happen, so we'll have to copy it explicitly.
  45.  
  46.     declare
  47.       Even,Odd:Full_Scan_Lines;
  48.         for Even
  49.           use at (Video_Ram_Segment,
  50.                   System.Offset_type(Line_Address(Target)));
  51.         for Odd
  52.           use at (Video_Ram_Segment,
  53.                   System.Offset_type(Line_Address(Target)+Odd_Bank_Offset));
  54.     begin
  55.       Even:=New_Scan_Line;
  56.       Odd:=New_Scan_Line;
  57.     end;
  58.     if Line_Address(Target) > Line_Addresses'last-Line_Width_In_Bytes+1 then
  59.       declare
  60.         Head_Length : constant Integer
  61.           :=Integer(Line_Addresses'last-Line_Address(Target)+1);
  62.         Tail_Length : constant Integer
  63.           := Line_Width_In_Bytes-Head_Length;
  64.         Tail : constant X_Range:=New_Scan_Line'first+Head_Length;
  65.       begin
  66.         Altslice.Movmem(
  67.            Source      => New_Scan_Line(Tail)'Address,
  68.            Destination => (Video_Ram_Segment,
  69.                            System.Offset_Type(Video_Ram_Addresses'first)),
  70.            N_Bytes     => System.Word(Tail_Length));
  71.       end;
  72.     end if;
  73.     -- line stored in video ram, now adjust 6845 Start Address register
  74.     declare
  75.       use System;
  76.       Status:System.Byte;
  77.       Word_Offset:constant Video_Ram_Addresses
  78.         :=Line_Address(Line_At_Top); -- /2;
  79.     begin
  80.       -- wait for out-of-vertical-retrace
  81.       loop
  82.         Bit.Inport(16#3DA#,Status);
  83.         exit when Status mod 16 < 8; -- exit when in vert retrace
  84.       end loop;
  85.       loop
  86.         Bit.Inport(16#3DA#,Status);
  87.         exit when Status mod 16 >= 8; -- exit when done vert retrace
  88.       end loop;
  89.       -- roll screen
  90.       Bit.Outport(16#3D4#,12);
  91.       Bit.Outport(16#3D5#,System.Byte(Word_Offset/256));
  92.       Bit.Outport(16#3D4#,13);
  93.       Bit.Outport(16#3D5#,System.Byte(Word_Offset mod 256));
  94.     end;
  95.   end Scroll;
  96.  
  97.   procedure Open_White_Screen is -- put CGA in 640x200 monochrome mode
  98.     Regs : Doscall.Simple_Regs := (AX => 16#0006#, others => 0);
  99.   begin
  100.     Doscall.Simple_Int_Call(16#10#, Regs);
  101.     -- paint screen white
  102.     Altslice.Setmem(Destination => (Video_Ram_Segment,0),
  103.                     Byte_Value  => System.Byte(White),
  104.                     N_Bytes     => Video_Ram_Length);
  105.   end Open_White_Screen;
  106.  
  107.   procedure Revert_To_Text is
  108.     Regs    : Doscall.Simple_Regs := (AX => 16#0003#, others => 0);
  109.   begin
  110.     Doscall.Simple_Int_Call(16#10#, Regs);
  111.   end Revert_To_Text;
  112.  
  113. begin -- CRT
  114.   -- initialize Line_Address table
  115.   declare
  116.     type Big_Integers is
  117.       range 0 .. Line_Width_In_Bytes*Number_Of_Different_Offsets;
  118.     Offset:Big_Integers:=0;
  119.   begin
  120.     for I in Line_Address'range loop
  121.       Line_Address(I)
  122.         :=Line_Addresses(Offset mod Big_Integers(Line_Addresses'last+1));
  123.       Offset:=Offset+Line_Width_In_Bytes;
  124.     end loop;
  125.   end;
  126.  
  127. end CRT;
  128.